perm filename MISEDG.SAI[SYS,HE]11 blob
sn#080524 filedate 1974-01-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ENTRY IMAGE,REJSUB,XGETD,INSUB,CURVE
C00008 00003 DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
C00012 00004 INITIALIZE PROGRAM FOR TV INPUT
C00016 00005 SELECT CORRECT OBJECT BLOCK. VALUE IS POINTER OR -1
C00018 00006 CALL MANFRED'S OPERATOR
C00023 00007 INITIALIZE
C00025 00008 DELETE COMMAND - ARG SET TO OBJECT DELETED ON EXIT,
C00034 00009 RELOOK COMMAND
C00036 00010 FILL DATA ARRAY FROM EDGE DATA RINGS
C00038 00011 DUMP DATA ARRAY ON DISK
C00040 00012 GUTS OF GET_DATA COMMAND
C00043 00013 ⊃ get object data and segment status for caller
C00045 00014 ⊃ for each segment find endpoint or a point,if any, out of window
C00048 00015 ⊃ go through associations generated and create output array
C00051 00016 ⊃ output array to user
C00052 00017 FIT COMMAND STATUS=-1 ON ENTRY IF NO LINE EXTENDING
C00060 ENDMK
C⊗;
ENTRY IMAGE,REJSUB,XGETD,INSUB,CURVE;
BEGIN "MISC"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE 500 STRING_SPACE;
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL INTEGER PROCEDURE GLABEL(REFERENCE REAL FOO);
EXTERNAL BOOLEAN PROCEDURE EJLI(INTEGER X, Y, ANGLE, FLAG);
EXTERNAL PROCEDURE FORG.;
EXTERNAL INTEGER PROCEDURE GGETD(INTEGER PNTR, CNT; REFERENCE BOOLEAN E);
EXTERNAL BOOLEAN PROCEDURE GIFTIE(INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GDOWN(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GFORWR(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL PROCEDURE GBACK(REFERENCE INTEGER PNTR, FLD; REFERENCE BOOLEAN E);
EXTERNAL INTEGER PROCEDURE GKILBL(REFERENCE INTEGER P; REFERENCE BOOLEAN F);
EXTERNAL INTEGER PROCEDURE GETCOR(INTEGER SIZE);
EXTERNAL PROCEDURE RELCOR(INTEGER PNTR);
EXTERNAL BOOLEAN PROCEDURE GSTATZ(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE GSETST(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE GSTATO(INTEGER MASK,PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL INTEGER PROCEDURE GCOUNT(INTEGER PNTR, FLD; REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE PICINI(INTEGER C,F,E,P;REFERENCE BOOLEAN FAIL;
INTEGER ARRAY STOR);
EXTERNAL PROCEDURE PICRD(REFERENCE BOOLEAN FAIL; INTEGER ARRAY STOR);
EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;REFERENCE BOOLEAN FAIL;
INTEGER ARRAY STOR);
EXTERNAL PROCEDURE TRACCHK;
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL PROCEDURE GSTORD(INTEGER VAL,PNTR,CNT;REFERENCE BOOLEAN ERR);
FORTRAN PROCEDURE DATGET;
EXTERNAL INTEGER PROCEDURE SETANG(INTEGER X,Y);
EXTERNAL PROCEDURE OUTOBJ(REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE FOO);
EXTERNAL INTEGER PROCEDURE GENTER(INTEGER X,Y; REFERENCE BOOLEAN TEST,DIR);
EXTERNAL PROCEDURE TVIN;
EXTERNAL PROCEDURE FINSCN(SET B; REFERENCE INTEGER S);
DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
CRLF="'15&'12",
SAFEX="SAFE", GET(I)="FOOLX(GGETD(PNTR,I,FLAG))", STLEN="6", DSK="5",
⊃="COMMENT", D1MAX="1000", D2MAX="100", MANMAX="100",
OUTLIN="2",CORRNG="1",DISFRM="2",PNTNUM="1",OBJNUM="3",OBJPNT="1",
CORPNT="1", SEGPNT="1", OBJRNG="1", LIMIT="4", CAMERA="8";
SAFEX INTERNAL SHORT INTEGER ARRAY STACK, COSTKX, COSTKY[1:STLEN];
SAFEX REAL ARRAY ITEMVAR NEWCAM, OUTXY, INXY, RAI;
INTERNAL SHORT INTEGER DISPNT, BACKFL;
INTERNAL REAL OWID, ORX, ORY, OCL, OSL, OD, OB;
REAL OGRAD;
INTERNAL BOOLEAN DISFLG, ACCOMINIT;
BOOLEAN FLAG, MAXDEB, DO_COL;
SHORT INTEGER FLD, FRAM, I, N, PNTR, PPN, SIZE, TEMP, TEST, FRAMX, CHAN;
EXTERNAL SHORT INTEGER XSTRT, YSTRT, TVWORD, TMAX, BMAX, RSMAX, LSMAX, TOPLST,
OBJLST, PNTLST, GPNTR, TEMPNT, LSIDE, RSIDE, FLINE, LLINE, BCLIP,
TCLIP, SAITEM, DEFT, DEFB, DEFR, DEFLX, TVWID, SEGLST, CORLST,
CURTEM, DISTST, DEBFRM, BITS, TVCAM;
EXTERNAL REAL CIRCLE, SIDLEN;
EXTERNAL BOOLEAN STVFL, ST, STV, SLIM, EDGINIT, DEBDEL, DEBUGX;
SAFEX SHORT INTEGER ARRAY STORAG,STOR[1:25], DISPL2[1:D2MAX+5];
SAFEX INTERNAL SHORT INTEGER ARRAY DISPL1[1:D1MAX+5];
comment variables:
STACK,COSTKX,COSTKY are stacks containing the last STLEN coordinates seen
by the edge follower and the pointers to the data
structure entry.
DISPNT contains the current display frame number.
OBJCNT contains the object number.
DISFLG is TRUE if display has been suppressed for any reason.
ACCOMINIT is TRUE if accomodation routines are initialized.
CIRCLE is the radius of the Manfred operators
DO_COL is TRUE if filters to be changed during inside scaning;
SIMPLE INTERNAL PROCEDURE DPYPNT(SHORT INTEGER X,Y);
BEGIN EXTERNAL INTEGER DEBFRM;
INTEGER DSAVE;
DSAVE ← DPYPARS;
DPYSET(DISPL2);
APOINT(X*3-512,512-Y*3);
DPYOUT(DEBFRM);
DPYRESET(DSAVE);
END;
COMMENT INITIALIZE PROGRAM FOR TV INPUT
(TVWID IS LENGTH OF INPUT SQUARE);
SIMPLE INTERNAL PROCEDURE INITTV;
BEGIN
RELCOR(TVWORD);
SIZE ← (TVWID/9+2)*(TVWID+1);
IF SIZE<500 THEN SIZE ← 500;
STV ← STVFL ← ST ← FALSE;
TVWORD ← GETCOR(SIZE);
BACKFL ← 0;
DEFR ← 300;
DEFLX ← 10;
DEFT ← 15;
DEFB ← 250;
XSTRT ← YSTRT ← 0;
EDGINIT ← ACCOMINIT ← FALSE;
CHANGE_ACC ← TRUE;
IF CHAN≥0 THEN RELEASE(CHAN);
CHAN ← -1;
END;
PROCEDURE GETTRANS;
BEGIN SHORT INTEGER I;
I ← (STORAG[7]+2) DIV 3;
BEGIN REAL ARRAY FOO[1:I,1:3];
CURCAM[TVCAM] ← GLOBAL NEW(FOO);
STOR[7] ← GLABEL(GLOBAL DATUM(CURCAM[TVCAM])[1,1]);
END;
END;
COMMENT INITIALIZE PROGRAM FOR DISK FILE NAM.DAT;
INTERNAL BOOLEAN PROCEDURE INITDK(STRING NAM);
BEGIN SHORT INTEGER I, FAIL;
LABEL L1;
RELCOR(TVWORD);
TVWORD ← 0;
STV ← STVFL ← ST ← TRUE;
N ← CVFIL(NAM,I,PPN);
IF CHAN≥0 THEN RELEASE(CHAN);
CHAN ← GETCHAN;
PICINI(CHAN,N,I,PPN,FAIL,STORAG);
IF FAIL∨¬STORAG[1] THEN
L1: BEGIN
INITTV;
RETURN(FALSE);
END;
TVWORD ← GETCOR(STORAG[1]);
BACKFL ← 0;
STOR[2] ← 0;
ARRBLT(STOR[3],STOR[2],23);
STOR[1] ← (TVWORD LAND '777777)+1;
IF STORAG[7] THEN GETTRANS ELSE CURCAM[TVCAM]←CVI(0);
PICRD(FAIL,STOR);
IF FAIL THEN GO TO L1;
RSMAX ← DEFR ← RSIDE;
LSMAX ← DEFLX ← LSIDE;
TMAX ← DEFT ← FLINE;
BMAX ← DEFB ← LLINE;
BCLIP ← 7;
TCLIP ← 0;
XSTRT ← YSTRT ← 0;
ACCOMINIT ← TRUE;
EDGINIT ← CHANGE_ACC ← FALSE;
RETURN(TRUE);
END;
⊃ GET ANOTHER PICTURE FROM DISK FILE;
INTERNAL BOOLEAN PROCEDURE GETFIL(SHORT INTEGER IND);
BEGIN SHORT INTEGER FAIL,I;
LABEL L1, L2;
STRING STR;
IF STORAG[IND] THEN
L1: BEGIN
STOR[1] ← 0;
ARRBLT(STOR[2],STOR[1],24);
STOR[IND]←(TVWORD LAND '777777)+1;
PICRD(FAIL,STOR);
IF FAIL THEN OUTSTR("INPUT FAILED"&CRLF);
END ELSE OUTSTR("REQUESTED COLOR NOT IN THIS FILE"&CRLF);
L2: OUTSTR("FILE IS (NULL TO QUIT"&CRLF);
RELCOR(TVWORD);
TVWORD ← 0;
IF LENGTH(STV←INCHWL) THEN BEGIN INITTV; RETURN(FALSE); END;
N ← CVFIL(STR,I,PPN);
PICINI(CHAN,N,I,PPN,FAIL,STORAG);
IF FAIL∨¬STORAG[IND] THEN BEGIN OUTSTR("FAILED"&CRLF);GO TO L2;END;
TVWORD ← GETCOR(STORAG[IND]);
IF STORAG[7] THEN GETTRANS ELSE CURCAM[TVCAM]←CVI(0);
RSMAX ← DEFR ← RSIDE;
LSMAX ← DEFLX ← LSIDE;
TMAX ← DEFT ← FLINE;
BMAX ← DEFB ← LLINE;
GO TO L1;
END;
COMMENT SELECT CORRECT OBJECT BLOCK. VALUE IS POINTER OR -1
IF NO BLOCK. EXECUTE XEQ IF FLG IS TRUE;
SIMPLE INTERNAL INTEGER PROCEDURE GETOBJ(REFERENCE ITEMVAR ARG;BOOLEAN FLG;
REFERENCE BOOLEAN PROCEDURE XEQ);
BEGIN ITEMVAR A;
LABEL L1;
IF ¬GIFTIE(PNTR←TOPLST,FLD←OBJPNT,FLAG)∨FLAG THEN RETURN(-1);
GDOWN(PNTR,FLD,FLAG);
TEST ← PNTR;
L1: IF ARG≠EVERY THEN
BEGIN
IF GGETD(PNTR,OBJNUM,FLAG)= CVN(ARG) THEN
RETURN(IF FLG∧¬XEQ(PNTR,ARG) THEN -1 ELSE PNTR)
END ELSE BEGIN
A ← CVI(GGETD(PNTR,OBJNUM,FLAG));
IF ¬FLG∨XEQ(PNTR,A) THEN BEGIN ARG←A;RETURN(PNTR);END;
END;
GFORWR(PNTR,FLD,FLAG);
IF PNTR≠TEST THEN GO TO L1;
RETURN(-1);
END;
COMMENT DUMMY ROUTINE FOR GETOBJ;
SIMPLE BOOLEAN PROCEDURE DUMMY(INTEGER A; ITEMVAR B);
RETURN(FALSE);
COMMENT CALL MANFRED'S OPERATOR
RETURNS:
-1 OUTSIDE FIELD OF VIEW
0 NOTHING SEEN
1 NOISY EDGE - JUMP AHEAD
2 FUNNY BRIGHNESS
3 OK;
INTERNAL INTEGER PROCEDURE YOPER(SHORT INTEGER X, Y;
REFERENCE SHORT INTEGER ANGLE; SHORT INTEGER CW;
BOOLEAN TRAC,FLAG);
BEGIN
EXTERNAL REAL B, TM ,TP, OPX, OPY, CX, CY, LINWID;
EXTERNAL BOOLEAN WEAK, NOISY, NEARED, OPOOB, BCOMP, ISLINE, ISEDGE;
BOOLEAN VAL;
DEFINE OBOOL(X)="("" X= "")&(IF X THEN ""TRUE"" ELSE ""FALSE"")";
SHORT INTEGER I, RET, XX, YY;
REAL MX;
MX ← (1 LSH BITS)+.5;
OGRAD ← OWID ← -1.0;
VAL ← EJLI(X,Y,ANGLE,FLAG);
IF OPOOB THEN RETURN(-1);
IF VAL∧(NEARED∨BCOMP)∧((XX←ORX)≠X∨(YY←ORY))≠Y THEN
BEGIN
VAL ← EJLI(OPX+.5,OPY+.5,ANGLE,FLAG);
IF OPOOB THEN RETURN(-1);
END;
OB ← B;
OD ← TM MAX (TM+TP);
IF VAL THEN
BEGIN
ORX ← OPX;
ORY ← OPY;
IF ¬BCOMP THEN BEGIN OCL ← CX;OSL ← CY;END;
ANGLE ← SETANG(OCL*15.0,OSL*15.0);
RET ← 3;
END ELSE IF NOISY THEN RET←1 ELSE RET←0;
IF DEBUGX THEN DPYPNT(X,Y);
IF (OB=0∧OD=0)∨¬(-.5<OB<MX)∨¬(-.5<OD<MX) THEN
BEGIN
IF RET=3 THEN RET←2;
OB ← OD ←GENTER(X,Y,I←0,I);
END ELSE
IF RET≥0 THEN IF CW>0 THEN OD←OB+OD ELSE BEGIN OB↔OD;OB←OB+OD;END;
RETURN(RET);
END;
COMMENT INITIALIZE;
EXTERNAL PROCEDURE REGEN(INTEGER OBJLST);
SIMPLE INTERNAL PROCEDURE DISINT;
BEGIN INTEGER I;
DPYCLR;
IF ¬RUN THEN DPYTYP(-140,15,1);
DISTST ← 15;
DISFLG ← FALSE;
DPYSET(DISPL1);
DPYBRT(7);
DPYBIG(4);
GPNTR ← GIOWD(STACK);
OVERLAY ← TRUE;
IF DISDEV THEN RETURN;
I ← -1;
START_CODE DEFINE TTY="'51000000000";
TTY 6,I;
END;
DISDEV←IF I<0 THEN 2 ELSE IF I LAND '20000000 THEN 3 ELSE 1;
END;
COMMENT FOOL INTEGER → REAL TYPE CONVERSION CHECK;
SIMPLE INTERNAL REAL PROCEDURE FOOLX(INTEGER A);
BEGIN REAL C;
START_CODE DEFINE MOVE="'200000000000";
MOVE A;
MOVEM C;
END;
RETURN(C);
END;
SIMPLE INTERNAL PROCEDURE DISREL(INTEGER PNTR);
BEGIN
DISPNT ← GGETD(PNTR,DISFRM, FLAG);
IF DISPNT<0 THEN RETURN;
RELPOG(DISPNT);
GSTORD(-1,PNTR,DISFRM,FLAG);
REGEN(-1);
END;
SIMPLE INTERNAL PROCEDURE COLON;
DO_COL ← TRUE;
SIMPLE INTERNAL PROCEDURE COLOFF;
DO_COL ← FALSE;
COMMENT DELETE COMMAND - ARG SET TO OBJECT DELETED ON EXIT,
NIL IF NONE - STATUS=-1 IF NO OBJECT;
⊃ DELETE GLOBAL STRUCTURE FOR BLOB A;
INTERNAL PROCEDURE GLBDEL(ITEMVAR A);
BEGIN SET D;
DEFINE !="GLOBAL";
ITEMVAR I;
D ← (! POINT⊗A)∪(! LINE⊗A)∪(! BACKGROUND⊗A)∪(! REGION⊗A)
∪(! DANGLE⊗A);
FOREACH I | ! LINE⊗A≡I DO ! ERASE ENDPT⊗I≡ANY;
FOREACH I | ! REGION⊗A≡I DO
BEGIN
D ← D∪(! PERIMETER⊗I);
! ERASE PERIMETER⊗I≡ANY;
END;
FOREACH I | Iε{POINT,LINE,BACKGROUND,REGION,DANGLE} DO
! ERASE I⊗A≡ANY;
WHILE LENGTH(D) DO ! DELETE(LOP(D));
END;
INTERNAL PROCEDURE REJSUB(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN EXTERNAL SET FNDBLB;
SAFEX REAL ARRAY ITEMVAR RAI;
STATUS ← 0;
IF (PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN
BEGIN
STATUS ← -1;
ARG ← NIL;
RETURN;
END;
DISREL(PNTR);
OBJLST ← PNTR;
FORG.;
TEMP ← PNTR;
GBACK(PNTR,FLD←OBJRNG,FLAG);
OBJLST ← PNTR;
REMOVE ARG FROM FNDBLB;
REMOVE ARG FROM BLOBS;
GLBDEL(ARG);
RAI ← CVI(GGETD(TEMP,CAMERA,FLAG));
GLOBAL ERASE XFORM⊗ARG≡ANY;
IF RAI≠NIL∧TYPEIT(RAI) THEN GLOBAL DELETE (RAI);
GKILBL(TEMP,FLAG);
SEGLST ← TEMPNT ← PNTLST ← -1;
FOR I←1 STEP 1 UNTIL STLEN DO STACK[I]←COSTKX[I]←COSTKY[I]←-1;
END;
COMMENT RELOOK COMMAND;
SIMPLE INTERNAL PROCEDURE LOOK(REFERENCE ITEMVAR ARG;
REFERENCE INTEGER STATUS; SHORT INTEGER X, Y);
BEGIN ITEMVAR Z;
SHORT INTEGER TOP, BOT, LEFT, RIGHT, HOR, VER;
REAL T,B,L,R;
BOOLEAN SAVE;
LABEL L2;
STATUS ← 0;
IF ARG=EVERY∨(PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN
BEGIN STATUS ← -1;ARG ← NIL;RETURN;END;
OBJLST ← PNTR;
IF ¬(ARGεBLOBS) THEN GO TO L2;
REMOVE ARG FROM BLOBS;
L2: PUT ARG IN OLDBLOB;
DATGET(OBJLST,LIMIT,4,T,B,L,R);
TOP ← T; BOT ← B; LEFT ← L; RIGHT ← R;
HOR ← (RIGHT-LEFT) DIV 2+15;
VER ← (BOT-TOP) DIV 2+15;
IF ¬X THEN X ← (RIGHT-LEFT) DIV 2+LEFT;
IF ¬Y THEN Y ← (BOT-TOP) DIV 2+TOP;
TOP ← Y-VER;
BOT ← Y+VER;
LEFT ← X-HOR;
RIGHT ← X+HOR;
IF TOP<TMAX THEN TOP ← TMAX;
IF BOT>BMAX THEN BOT←BMAX;
IF LEFT<LSMAX THEN LEFT ← LSMAX;
IF RIGHT>RSMAX THEN RIGHT ← RSMAX;
TOP ↔ TMAX;
BOT ↔ BMAX;
LEFT ↔ LSMAX;
RIGHT ↔ RSMAX;
XSTRT ← X;
YSTRT ← BMAX-(BMAX-TMAX) DIV 4;
REJSUB(Z←ARG, STATUS);
SAVE ← SLIM;
SLIM ← TRUE;
EDGE_KKP(ARG,STATUS);
SLIM ← SAVE;
ARG ← NIL;
STATUS ← 0;
TOP ↔ TMAX;
BOT ↔ BMAX;
LEFT ↔ LSMAX;
RIGHT ↔ RSMAX;
END;
COMMENT FILL DATA ARRAY FROM EDGE DATA RINGS;
SIMPLE PROCEDURE GET_DATA(SAFEX REAL ARRAY D;REFERENCE SHORT INTEGER CNT;
LIST OBJS);
BEGIN REAL X,Y,SL,CL;
ITEMVAR AR;
SHORT INTEGER PA,FA,TA,PB,FB,TB,CURCNT,LASTPNT,PTR;
BOOLEAN CLOSED;
CNT ← 0;
WHILE LENGTH(OBJS) DO
BEGIN "OBJS"
AR←LOP(OBJS);
PTR ← GETOBJ(AR,FALSE,DUMMY);
IF PTR≤0 THEN CONTINUE;
D[CNT+1,3]←CVN(AR);
GDOWN(PA ← PTR, FA ← OUTLIN, FLAG);
TA ← PA LAND '777777;
DO BEGIN
CURCNT ← 0;
LASTPNT ← CNT ← CNT+1;
CLOSED ← GSTATZ(7,PA,FLAG);
GDOWN(PB ← PA, FB ← SEGPNT, FLAG);
IF ¬CLOSED THEN WHILE GSTATZ(24,PB,FLAG) DO
GBACK(PB,FB,FLAG);
IF GSTATO(8,PB,FLAG)∧GSTATZ(16,PB,FLAG) THEN
BEGIN
DEBOUT("""FLAG MISSING - GET_DATA""");
GFORWR(PB,FB,FLAG);
GSETST(16,PB,FLAG);
END;
TB ← PB LAND '777777;
DO BEGIN
CURCNT ← CURCNT+1;
DATGET(PB,1,4,X,Y,CL,SL);
D[CNT←CNT+1,1] ← X;
D[CNT,2] ← Y;
D[CNT,3] ← CL;
D[CNT,4] ← SL;
GFORWR(PB, FB, FLAG);
END UNTIL TB=(PB LAND '777777);
D[LASTPNT,1] ← CURCNT;
D[LASTPNT,2] ← CNT+1;
D[LASTPNT,4] ← CLOSED;
D[CNT+1,3] ← 0;
GFORWR(PA,FA,FLAG);
END UNTIL TA=(PA LAND '777777);
END "OBJS";
D[LASTPNT,2] ← 0;
END;
COMMENT DUMP DATA ARRAY ON DISK;
SIMPLE PROCEDURE DUMPDAT(SAFEX REAL ARRAY DAT; SHORT INTEGER K,KK);
BEGIN SHORT INTEGER LL,J,I;
OPEN(DSK,"DSK",1,0,2,100,LL,LL);
OUTSTR("FILE ="&CRLF);
ENTER(DSK,INCHWL,FLAG);
SETFORMAT(25,10);
OUT(DSK,CVS(K)&CVS(KK)&CVF(SIDLEN)&CRLF);
FOR J←1 STEP 1 UNTIL K DO OUT(DSK,CVF(DAT[J,1])&CVF(DAT[J,2])&
CVF(DAT[J,3])&CVF(DAT[J,4])&CRLF);
IF CVN(CURCAM[TVCAM])>0∧CURCAM[TVCAM]≠NIL THEN
BEGIN
K ← ARRINFO(GLOBAL DATUM(CURCAM[TVCAM]),2);
OUT(DSK,CVS(K)&CRLF);
FOR J←1 STEP 1 UNTIL K DO
BEGIN
FOR I←1 STEP 1 UNTIL 3 DO
OUT(DSK,CVG(GLOBAL DATUM(CURCAM[TVCAM])[J,I]));
OUT(DSK,CRLF);
END;
END ELSE OUT(DSK,"0"&CRLF);
RELEASE(DSK);
END;
COMMENT CALLING PROGRAM FOR FINE OPERATION;
INTERNAL PROCEDURE XFINE(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN ITEMVAR NARG;
SIMPLE BOOLEAN PROCEDURE TST(REFERENCE INTEGER P;
REFERENCE ITEMVAR ARG);
RETURN(GSTATZ(32,P,FLAG));
IF (PNTR←GETOBJ(ARG,TRUE,TST))<0 THEN
BEGIN
STATUS ← -1;
ARG ← NIL;
RETURN;
END;
NARG ← IF ARG=EVERY THEN CVI(GGETD(PNTR,OBJNUM,FLAG)) ELSE ARG;
OBJLST ← PNTR;
FINSCN({NARG},STATUS);
STATUS ← 0;
END;
COMMENT GUTS OF GET_DATA COMMAND;
PROCEDURE FXUP(REFERENCE LIST OB);
BEGIN
ITEMVAR ARG;
SHORT INTEGER I;
IF ¬LENGTH(OB) THEN RETURN;
IF OB[1] = NIL THEN
BEGIN
I ← GGETD(OBJLST,OBJNUM,FLAG);
OB ← IF I≥0 THEN {{CVI(I)}} ELSE {{}};
RETURN;
END;
IF OB[1] = EVERY THEN
BEGIN LIST FOO;
SIMPLE BOOLEAN PROCEDURE TEST(REFERENCE INTEGER PNTR;
REFERENCE ITEMVAR ARG);
RETURN(¬LISTX(FOO,ARG,1));
FOO ← PHI;
WHILE GETOBJ(ARG←EVERY,TRUE,TEST)>0 DO
PUT ARG IN FOO AFTER ∞;
OB ← FOO;
END;
END;
INTERNAL BOOLEAN PROCEDURE XGETD(LIST OBJS; STRING JOB);
BEGIN
ITEMVAR ARG;
SHORT INTEGER SIZ, PNTR, K, I, J, S, SS, SUM;
FXUP(OBJS);
I ← LENGTH(OBJS);
SUM ← SIZ ← 0;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
ARG ← OBJS[J];
IF (PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN CONTINUE;
S ← GGETD(PNTR, PNTNUM, FLAG);
SS ← GCOUNT(PNTR,OUTLIN,K);
IF ¬FLAG∨¬K THEN
BEGIN
SIZ ← SIZ+S+SS;
SUM←SUM+S;
END;
END;
IF ¬SIZ THEN RETURN(TRUE);
BEGIN
SAFEX REAL ARRAY DAT[1:(SIZ+5),1:4];
GET_DATA(DAT,K,OBJS);
IF YES_GUN THEN
BEGIN "GUNLO"
ISSUE(1,"EDGE","GUNLO",MESSAGE G_EDGES(DAT,TVCAM,
K,SIDLEN));
ISSUE(1,"EDGE","GUNLO",
MESSAGE GUN_COM("RECEIVE EDGES"));
END "GUNLO" ELSE
IF EQU(JOB,"TTY") THEN DUMPDAT(DAT,K,SUM) ELSE
ISSUE(1,"EDGE",JOB,MESSAGE SEND_DATA(K, DAT));
RETURN(FALSE);
END;
END;
⊃ get object data and segment status for caller;
INTERNAL BOOLEAN PROCEDURE XGETS(LIST OBJS; REAL T,B,L,R; STRING JOB);
BEGIN ITEMVAR ARG;
SHORT INTEGER SIZ, I, J, PNTR,PEND,PT,IND,PA,PNEND,K,PB,S,CNTR;
SET GOODOBJ, OBJECT;
BOOLEAN SEGFLG, LIM;
REAL X, Y, CL, SL, BLL, BR, TL, BL, RL, LL;
DEFINE H(A)="(A LAND '777777)";
SIMPLE INTEGER PROCEDURE GETST(INTEGER PNTR);
START_CODE
MOVE 1,PNTR;
HRRZ 1,(1);
ANDI 1,7;
END;
FXUP(OBJS);
OBJECT ← CVSET(OBJS);
GOODOBJ ← PHI;
CNTR ← 0;
⊃ loop through each object;
WHILE LENGTH(OBJECT) DO
BEGIN "OBJGET"
ARG ← LOP(OBJECT);
IF (PNTR←GETOBJ(ARG,FALSE,DUMMY))<0 THEN CONTINUE;
DATGET(PNTR,4,4,TL,BL,LL,RL);
LIM ← T>0;
IF LIM THEN
BEGIN
IF BL<T∨TL>B∨LL>R∨RL<L THEN CONTINUE;
IF BL≤B∧TL≥T∧LL≥L∧RL≤R THEN LIM ← FALSE;
END;
GDOWN(PT←PNTR,I←OUTLIN,FLAG);
IF FLAG THEN CONTINUE;
PUT ARG IN GOODOBJ;
PEND ← H(PT);
⊃ if object inside window, if any, loop through segments;
DO BEGIN "SEGGET"
SIZ ← GCOUNT(PT,SEGPNT,FLAG);
IF SIZ THEN BEGIN "PNTGET"
SAFEX REAL ARRAY SP[0:SIZ,1:6];
LABEL NXTPNT, LOOP;
GDOWN(PA←PT,J←SEGPNT,FLAG);
IND ← 0;
⊃ for each segment find endpoint or a point,if any, out of window
for closed curves;
PNEND ← H(PA);
IF ¬GSTATZ(7,PT,FLAG) THEN
BEGIN "DANG"
WHILE GSTATZ(24,PA,FLAG) DO
GBACK(PA,J,FLAG);
PNEND ← H(PA);
END "DANG" ELSE IF LIM THEN
BEGIN "CHECK"
PB ← PA;
S ← J;
DO BEGIN "OUTSID"
DATGET(PB,1,2,X,Y);
IF ¬(T≤Y≤B∧L≤X≤R) THEN
BEGIN "INSID"
PA←PNEND←H(PB);
DONE;
END "INSID";
GFORWR(PB,S,FLAG);
END "OUTSID"
UNTIL H(PB)=PNEND;
END "CHECK";
⊃ fill array with one segment and generate association
if segment crosses window boundary, it may have several portions
of it inside window, each becoming a seperate segment in output;
SEGFLG ← FALSE;
NXTPNT: DATGET(PA,1,6,X,Y,CL,SL,BLL,BR);
IF LIM THEN IF ¬(T≤Y≤B∧L≤X≤R) THEN
BEGIN "OUTER"
IF SEGFLG THEN
BEGIN "NEWASS"
IF ¬SP[0,6] THEN SP[0,6]←4;
SP[0,1] ← IND;
GLOBAL MAKE SEGM⊗ARG
≡GLOBAL NEW(SP);
CNTR←CNTR+IND+1;
IND ← 0;
SEGFLG ← FALSE;
END "NEWASS";
GO TO LOOP;
END "OUTER";
SEGFLG ← TRUE;
K ← GETST(PA);
IF ¬IND THEN
BEGIN
IF ¬K∧PA≠PNEND THEN K←4;
SP[0,5] ← K;
END;
SP[0,6] ← K;
IND ← IND+1;
SP[IND,1] ← X;
SP[IND,2] ← Y;
SP[IND,3] ← CL;
SP[IND,4] ← SL;
SP[IND,5] ← BLL;
SP[IND,6] ← BR;
LOOP: GFORWR(PA,J,FLAG);
IF H(PA)≠PNEND THEN GO TO NXTPNT;
IF IND THEN
BEGIN "ASSOC"
SP[0,1] ← IND;
GLOBAL MAKE SEGM⊗ARG≡GLOBAL NEW(SP);
CNTR ← CNTR+IND+1;
END "ASSOC";
END "PNTGET";
GFORWR(PT,I,FLAG);
END "SEGGET" UNTIL H(PT)=PEND;
END "OBJGET";
CNTR ← CNTR+LENGTH(GOODOBJ);
⊃ go through associations generated and create output array;
IF (CNTR-LENGTH(GOODOBJ))>0 THEN
BEGIN "GENER" SET SEGS;
SAFEX REAL ARRAY A[1:CNTR,1:6];
SHORT INTEGER LSTOBJ, CUROBJ, CURSEG, LSTSEG, SC, PTR, I, J;
SAFEX REAL ARRAY ITEMVAR R;
DEFINE ∂="GLOBAL DATUM";
PTR ← LSTOBJ ← 0;
WHILE LENGTH(GOODOBJ) DO
BEGIN "OBJ"
ARG ← LOP(GOODOBJ);
SEGS ← GLOBAL SEGM⊗ARG;
IF ¬LENGTH(SEGS) THEN CONTINUE;
DATGET(GETOBJ(ARG,FALSE,DUMMY),4,3,TL,BL,LL,RL);
PTR ← CUROBJ ← PTR+1;
A[PTR,1] ← CVN(ARG);
A[PTR,2] ← LENGTH(SEGS);
A[PTR,3] ← TL;
A[PTR,4] ← BL;
A[PTR,5] ← LL;
A[PTR,6] ← RL;
LSTSEG ← 0;
WHILE LENGTH(SEGS) DO
BEGIN "SEGS"
R ← LOP(SEGS);
CURSEG ← PTR+1;
PTR ← ∂(R)[0,1];
FOR SC←0 STEP 1 UNTIL PTR DO
FOR J←1 STEP 1 UNTIL 6 DO
A[CURSEG+SC,J]←∂(R)[SC,J];
PTR ← CURSEG+PTR;
A[CURSEG,2] ← 0;
A[CURSEG,3] ← CUROBJ;
A[CURSEG,4] ← LSTSEG;
LSTSEG ← CURSEG;
GLOBAL ERASE SEGM⊗ARG≡R;
GLOBAL DELETE(R);
END "SEGS";
IF LSTOBJ THEN
BEGIN "LAST"
I ← A[LSTOBJ,2];
SC ← LSTOBJ+1;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
A[SC,2] ← CUROBJ;
SC ← SC+A[SC,1]+1;
END;
END "LAST";
LSTOBJ ← CUROBJ;
END "OBJ";
⊃ output array to user;
IF EQU(JOB,"TTY") THEN
BEGIN "TTYOUT"
OPEN(DSK,"DSK",1,0,2,100,I,I);
OUTSTR("FILE="&CRLF);
ENTER(DSK,INCHWL,FLAG);
SETFORMAT(15,5);
OUT(DSK,CVS(CNTR)&CRLF);
FOR J←1 STEP 1 UNTIL CNTR DO
BEGIN
FOR I←1 STEP 1 UNTIL 6 DO
OUT(DSK,CVF(A[J,I]));
OUT(DSK,CRLF);
END;
RELEASE(DSK);
END "TTYOUT" ELSE
ISSUE(1,"EDGE",JOB,MESSAGE SEND_STATUS
(CNTR,A));
END "GENER";
RETURN(FALSE);
END;
COMMENT FIT COMMAND STATUS=-1 ON ENTRY IF NO LINE EXTENDING
TO BE DONE
STATUS= -2 CURVE FITTER BLEW UP (INTERNAL ONLY)
-1 NO OBJECT
0 OK
1 OK BUT NOT A CLOSED CURVE;
INTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN SHORT INTEGER I, J, SIZ, S;
LABEL L1, L2;
REAL X, Y, XX, YY;
SIMPLE BOOLEAN PROCEDURE TEST(REFERENCE INTEGER PNTR;
REFERENCE ITEMVAR ARG);
RETURN(GSTATZ(8,PNTR,FLAG));
TRACCHK;
IF (PNTR←GETOBJ(ARG,TRUE,TEST))<0 THEN
BEGIN
L1: STATUS ← -1;
ARG ← NIL;
RETURN;
END;
GLBDEL(ARG);
OBJLST ← PNTR;
CURVE_STATUS ← STATUS=-1;
SIZ ← (S←GGETD(PNTR,PNTNUM,FLAG))+GCOUNT(PNTR,OUTLIN,FLAG)+5;
IF SIZ<6 THEN GO TO L1;
BEGIN SAFEX REAL ARRAY DAT[1:SIZ,1:4];
GET_DATA(DAT,SIZ,{{CVI(GGETD(PNTR,OBJNUM,FLAG))}});
IF SIZ<4 THEN GO TO L1;
IF YES_CUR THEN
I←ISSUE(0,"EDGE","CURVE",MESSAGE CURVE_FIT(DAT))
ELSE DUMPDAT(DAT,SIZ,S);
END;
IF YES_CUR THEN QUEUE(7,I);
STATUS ← CURVE_STATUS;
IF STATUS=-2 THEN
BEGIN
REJSUB(ARG,I);
STATUS ← -1;
RETURN;
END;
NEWCAM ← CVI(GGETD(OBJLST,CAMERA,FLAG));
IF NEWCAM≠NIL THEN GLOBAL MAKE XFORM⊗ARG≡NEWCAM;
GSETST(8,OBJLST,FLAG);
IF YES_CUR THEN REGEN(OBJLST);
L2: CORLST ← CURTEM ← TEMPNT ← PNTLST ← SEGLST ← -1;
END;
END "MISC";